home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
newsgrp
/
group97b.txt
/
000014_icon-group-sender _Fri Jul 4 08:02:35 1997.msg
< prev
next >
Wrap
Internet Message Format
|
2000-09-20
|
14KB
Received: from kingfisher.CS.Arizona.EDU by cheltenham.cs.arizona.edu; Tue, 8 Jul 1997 08:45:36 MST
Received: by kingfisher.CS.Arizona.EDU; (5.65v3.2/1.1.8.2/08Nov94-0446PM)
id AA24226; Tue, 8 Jul 1997 08:45:35 -0700
Posted-Date: Fri, 4 Jul 1997 08:02:35 -0500 (CDT)
Date: Fri, 4 Jul 1997 08:02:35 -0500 (CDT)
From: Chris Tenaglia <cdt@post.its.mcw.edu>
To: icon-group@cs.arizona.edu
Subject: 4th of July Sample 2
Message-Id: <Pine.SOL.3.96.970704075127.21094B-100000@post.its.mcw.edu>
Mime-Version: 1.0
Content-Type: TEXT/PLAIN; charset=US-ASCII
Errors-To: icon-group-errors@cs.arizona.edu
Status: RO
And for our second offering I post a binary file editor.
I've used it on files up to 1MB. It views the file in
terms of 256 byte sectors. It also assumes some kind of
vt terminal emulation. This is getting close to system
programming and the code gets thick doing binhex conversions
and tracking screen locations. But I pity someone trying to
do this in perl, c, or shell script. I suppose there is
something you could buy to do this, but I didn't know of
any so I wrote this. It took less time than the cost justification
paperwork to buy a piece of software.
*** danger : binary editing requires that you know what ***
*** are doing. Study carefully,test thoroughly ***
*** and there's no guarantee. Have fun! ***
*** Yes, I have used it successfully on real stuff
So on with the code.
######################## BEGIN PROGRAM #######################
#
# file : aped.icn
# desc : binary editor like the old aped from srt days (unix version)
# use : aped file
#
# update by what
# 02-sep-1995 tenaglia initial write
# 08-sep-1995 tenaglia port this one to unix
#
global sctrs, pointer, hex, block, red, green, blue, black, con, coff, file
procedure main(param)
write(con,blue,"\e[2JAPED V1.0 by Tenaglia")
file := param[1] | input("File:")
(in := open(file,"ur")) | stop(con,black,at(23,1),"No ",file)
sctrs := []
count := 0
green := "\e[1;33;42m"
blue := "\e[1;33;44m"
red := "\e[1;33;41m"
black := "\e[0m"
con := "\e[?25h"
coff := "\e[?25l"
hex := "0123456789ABCDEF"
#
# load the file into a sector list here
#
while block := reads(in,256) do
{
if *block < 256 then
{
final := *block
block := left(block,256,"\000")
}
put(sctrs,block)
count +:= 1
}
close(in)
writes(con)
pointer := 1 # begin at sector 1
repeat if patch(file)=="EXIT" then break # continue patching
#
# perhaps even write out the changes
#
(out := open(file,"wu")) | stop(con,black,at(23,1),"Can't write ",file)
if *sctrs > 1 then every i := 1 to *sctrs-1 do writes(out,sctrs[i])
tail := sctrs[-1]
writes(out,tail[1+:final])
close(out)
write(con,black,at(23,1),file," rewritten.")
end
#
# prompt for an input string
#
procedure input(prompt)
writes(con,prompt)
return read()
end
#
# parse a string into a list with respect to a delimiter
#
procedure parse(line,delims)
static chars
chars := &cset -- delims
tokens := []
line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
return tokens
end
#
# patch oversees the display and edit of binary data
#
procedure patch(item)
display(item)
result := edit()
sctrs[pointer] := block
case result of
{
"QUIT" : stop(con,black,at(23,1),"Cancelled.")
"SAVE" | "EXIT" : return "EXIT"
"N" | "NEXT" : pointer +:= 1
"P" | "PRIOR": pointer -:= 1
"H" | "HOME" : pointer := 1
"?" | "HELP" : help()
"$" | "END" : pointer := *sctrs
"G" | "GOTO" : pointer := input(at(23,1) || blue || "GOTO SCTR # :")
}
if pointer < 1 then pointer := 1
if pointer > *sctrs then pointer := *sctrs
if match("DUMP",map(result,&lcase,&ucase)) then dump()
if match("GOTO",map(result,&lcase,&ucase)) & (*result > 6)then
{
new := trim(result[6:0])
if new == "" then new := input(at(23,1) || blue || "GOTO SCTR # :")
pointer := new
}
end
#
# display the 256 byte block
#
procedure display(object)
write(blue,"\e[2J\e[HAPED V.1 Sector ",pointer," of ",*sctrs," of ",object,"\n")
block := sctrs[pointer]
every i := 1 to 256 do
{
b := ord(block[i])
b1 := (b / 16) + 1
b2 := b - (b1 * 16)
writes(hex[b1],hex[b2]," ")
if i%16 = 0 then
{
base := (pointer - 1) * 256
offset := i - 16
address:= radcon(base + offset,10,16)
write(" : ",address)
}
}
end
#
# update the matrix of hex numbers currently displayed
# There are 16 bytes per line, and 16 lines that are updatable
#
# row = index / 16 +3
# col = index % 16 * 3
#
procedure edit()
index := 1
hexset := cset(hex)
oldrow := 0
oldcol := 0
oldb1 := -1
oldb2 := -1
color := blue
writes(coff)
repeat
{
b := ord(block[index])
row := ((index - 1) / 16) + 3
col := ((index - 1) % 16) * 3 + 1
b1 := (b / 16) + 1
b2 := b - (b1 * 16)
writes(at(row,col),green,hex[b1],hex[b2])
(oldcol = 0) | writes(at(oldrow,oldcol),blue,hex[oldb1],hex[oldb2])
kee := lawkey() # keyname(kee)
if *kee = 1 then kee := map(kee,&lcase,&ucase)
case kee of
{
"0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" |
"8" | "9" | "A" | "B" | "C" | "D" | "E" | "F" :
{
writes(at(row,col),red,kee)
other := map(getch(),&lcase,&ucase)
any(hexset,other) | next
writes(at(row,col+1),red,other)
value := 16 * (find(kee,hex) - 1) + (find(other,hex) - 1)
color := if block[index] == char(value) then blue else red
block[index] := char(value)
index +:= 1
if index > 256 then index := 1
next
}
"G" : return "GOTO"
" " | "N" : return "NEXT"
"P" : return "PRIOR"
"X" : return "SAVE"
"Z" : return "DUMP"
"?" : return "HELP"
"Q" : return "QUIT"
}
color := blue
case kee of
{
":" |
"ESCAPE" : return map(input(at(23,1) || blue || "Command:"),&lcase,&ucase)
"PAGEDOWN" : return "NEXT"
"PAGEUP" : return "PRIOR"
"F10" : { writes(at(23,1)) ; return "SAVE" }
"HOME" : return "HOME"
"END" : return "END"
"CTRL_C" : return "QUIT"
"RETURN" |
"ENTER" :
{
oldb1 := b1 ; oldb2 := b2
oldrow:= row; oldcol:= col
new := 16 * integer((index + 16) / 16)
index := new + 1
if index > 256 then index -:= 256
next
}
"RIGHTARROW" |
"SPACE" |
"TAB": {
oldb1 := b1 ; oldb2 := b2
oldrow := row ; oldcol:= col
index +:= 1
if index>256 then index := 1
next
}
"LEFTARROW" :
{
oldb1 := b1 ; oldb2 := b2
oldrow := row ; oldcol:= col
index -:= 1
if index<1 then index := 256
next
}
"UPARROW" :
{
oldb1 := b1 ; oldb2 := b2
oldrow := row ; oldcol:= col
index -:= 16
if index<1 then index +:= 256
next
}
"DOWNARROW" :
{
oldb1 := b1 ; oldb2 := b2
oldrow := row ; oldcol:= col
index +:= 16
if index>256 then index -:= 256
next
}
}
}
end
#
# \ button := getch()
# usage > if button == "\000" then button ||:= getch()
# / pressed := keyname(button)
#
# map unusual keys to a string
#
procedure keyname(str)
static keys
initial {
keys := table("ANY")
keys["\000;"] := "F1"
keys["\000<"] := "F2"
keys["\000="] := "F3"
keys["\000>"] := "F4"
keys["\000?"] := "F5"
keys["\000@"] := "F6"
keys["\000A"] := "F7"
keys["\000B"] := "F8"
keys["\000C"] := "F9"
keys["\000D"] := "F10"
keys["\000\373"] := "F12"
keys["\000H"] := "UPARROW"
keys["\000P"] := "DOWNARROW"
keys["\000M"] := "RIGHTARROW"
keys["\000K"] := "LEFTARROW"
keys["\000I"] := "PAGEUP"
keys["\000Q"] := "PAGEDOWN"
keys["\000G"] := "HOME"
keys["\000O"] := "END"
keys["\000R"] := "INSERT"
keys["\000S"] := "DELETE"
keys["\e"] := "ESCAPE"
keys["\001"] := "CTRL_A"
keys["\002"] := "CTRL_B"
keys["\003"] := "CTRL_C"
keys["\004"] := "CTRL_D"
keys["\005"] := "CTRL_E"
keys["\006"] := "CTRL_F"
keys["\007"] := "BELL"
keys["\010"] := "BACKSPACE"
keys["\011"] := "TAB"
keys["\012"] := "LINEFEED"
keys["\013"] := "CTRL_K"
keys["\014"] := "FORMFEED"
keys["\015"] := "RETURN"
keys["\016"] := "CTRL_N"
keys["\017"] := "CTRL_O"
keys["\020"] := "CTRL_P"
keys["\021"] := "CTRL_Q"
keys["\022"] := "CTRL_R"
keys["\023"] := "CTRL_S"
keys["\024"] := "CTRL_T"
keys["\025"] := "CTRL_U"
keys["\026"] := "CTRL_V"
keys["\027"] := "CTRL_W"
keys["\030"] := "CTRL_X"
keys["\031"] := "CTRL_Y"
keys["\032"] := "CTRL_Z"
}
return keys[str]
end
#
# THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
#
procedure at(y,x)
return "\e[" || y || ";" || x || "f"
end
#
# the next several modules are used to do base conversions
# the most common being between 10 and 16
#
procedure exbase10(i,j)
static digits
local s, d, sign
initial digits := &digits || &lcase
if i = 0 then return 0
if i < 0 then {
sign := "-"
i := -i
}
else sign := ""
s := ""
while i > 0 do {
d := i % j
if d > 9 then d := digits[d + 1]
s := d || s
i /:= j
}
return sign || s
end
procedure inbase10(s,i)
if s[1] == "-" then return "-" || integer(i || "r" || s[2:0])
else return integer(i || "r" || s)
end
procedure radcon(s,i,j)
return exbase10(inbase10(s,i),j)
end
#
# detects keys from a LAWSON UNIVERSE client
#
procedure lawkey()
k := getch()
if k == "\x18" then return "F11"
if k == "\003" then return "CTRL_C"
if k == "\d" then return "DEL"
if k == "\n" then return "ENTER"
if k == "\t" then return "TAB"
if k == "\r" then return "RETURN"
if k == " " then return "SPACE"
(k == "\e") | (return k)
k2 := getch()
(k2 == "[") | (k2 == "O") | return image(k || k2)
k3 := getch()
case k2 of
{
"[" : case k3 of {
"A" : return "UPARROW"
"B" : return "DOWNARROW"
"C" : return "RIGHTARROW"
"D" : return "LEFTARROW"
"V" : return "PAGEUP"
"U" : return "PAGEDOWN"
"4" : { getch() ; return "INS" }
default : return image(k || k2 || k3)
}
"O" : case k3 of {
"P" : return "F1"
"Q" : return "F2"
"R" : return "F3"
"S" : return "F4"
"T" : return "F5"
"U" : return "F6"
"V" : return "F7"
"W" : return "F8"
"X" : return "F9"
"Y" : return "F10"
"E" : return "STAB"
"]" : return "HOME"
"^" : return "END"
"o" : return "KP-"
default : return image(k || k2 || k3)
}
default : return image(k || k2 || k3)
}
return "?" || image(k || k2 || k3)
end
#
# dump the current image, by writing out the current sectors
# to a tmp file and then running hd in aped mode.
#
procedure dump()
temp := "aped.tmp"
dumpfile := trim(file) || ".dmp"
final := *block
cmd := "which hd >" || temp
system(cmd)
write(con,at(23,1),black)
(in := open(temp)) | { error("No hd command") ; return }
result := read(in)
close(in)
if find("not found",result) then { error("No hd command") ; return }
write(con,"Generating dump file...")
(out := open(temp,"wu")) | stop(con,black,at(23,1),"Can't write ",file)
if *sctrs > 1 then every i := 1 to *sctrs-1 do writes(out,sctrs[i])
tail := sctrs[-1]
writes(out,tail[1+:final])
close(out)
cmd := "hd " || temp || " -aped >" || dumpfile
system(cmd)
write(con,dumpfile," written. Press ENTER to continue.")
getch()
end
#
# display an error message
#
procedure error(msg)
write(con,"\7",msg)
writes(con,"Press ENTER to continue.")
getch()
end
#
# brief online help screen
#
procedure help()
write(con,at(10,10),red," Very Brief Help ")
write(con,at(11,10),red," : - Command Mode ")
write(con,at(12,10),red," G - Goto Sctr : GOTO ")
write(con,at(13,10),red," N - Next Sctr : NEXT ")
write(con,at(14,10),red," P - Prior Sctr : PRIOR ")
write(con,at(15,10),red," H - Home Sctr 1 : HOME ")
write(con,at(16,10),red," $ - Last Sctr : EOF ")
write(con,at(17,10),red," Q - Quit/nosave : QUIT ")
write(con,at(18,10),red," X - Exit/Save : EXIT ")
write(con,at(19,10),red," Z - Dump Hex : DUMP ")
write(con,at(20,10),red," Press ENTER to continue. ")
getch()
end
#################### END PROGRAM #########################
Chris Tenaglia (system manager) | The future foretold,
Medical College of Wisconsin | The past explained,
8701 W. Watertown Plank Rd. | The present largely appologized for.
Milwaukee, WI 53226 (414)456-8765 | Organon to the Doctor